home *** CD-ROM | disk | FTP | other *** search
/ CBM Funet Archive / cbm-funet-archive-2003.iso / cbm / c64 / programming / atbasic.lzh / atbasic / src / SBK 5.3 .S 2,P (.txt) < prev    next >
Encoding:
Commodore BASIC  |  1996-03-04  |  9.1 KB  |  222 lines
  1. 10 getkint jsr prkomma
  2. 20 getint  jsr chr(NULL)t:jsr frmnum:jmp getadr
  3. 100 ;**** parameter fuer delete/list holen
  4. 110 parlist bcc a1:beq a1:cmp # 171
  5. 120 bne delerr1:a1 jsr getznr:jsr adrzei
  6. 130 jsr chr(NULL)t:beq a2:cmp # 171
  7. 140 delerr1 bne delerr:jsr chrget:jsr getznr
  8. 150 bne delerr:a2 rts:;:;******** delete:;:delete jsr parlist
  9. 160 lda intadr:ora intadr+1:bne a3
  10. 170 ldy # 0:tya:a03 sta (flag5f),y:iny:sta (flag5f),y:jmp a9
  11. 180 a3 lda flag5f
  12. 190 ldy flag5f+1:sta flag22:sty flag22+1
  13. 200 jsr adrzei:bcc a5:ldy # 0
  14. 210 lda (flag5f),y:iny :pha
  15. 220 lda (flag5f),y:sta flag5f+1:pla
  16. 230 sta flag5f
  17. 231 a5 lda flag22+1:cmp flag5f+1:bcc a5a:bne a9
  18. 232 lda flag22:cmp flag5f:bcs a9
  19. 240 a5a ldy #0:ldx # 3:a6 lda (flag5f),y
  20. 250 sta (flag22),y:cmp # 0:bne a7
  21. 260 dex :beq a9:bne a8
  22. 270 a7 ldx # 3:a8 iny :bne a6
  23. 280 inc flag22+1:inc flag5f+1:jmp a6
  24. 290 a9 jsr bindbas:lda # 2:clc
  25. 300 adc flag22:sta varstart:lda flag22+1
  26. 310 adc # 0:sta varstart+1:jmp $a663
  27. 320 delerr jmp syntax
  28. 330 ;:;******** old:;
  29. 340 old bne delerr
  30. 350 ldy #1:tya:sta ($2b),y
  31. 370 jsr a9:jmp ready
  32. 380 ;**** parameter fuer auto/renumber holen
  33. 390 paraut lda # 0:sta flagfb+1:sta flagfe
  34. 400 lda # 10:sta flagfb:lda # 100
  35. 410 sta flagfd:jsr weitzei:cmp #",":beq paraut1:jsr chr(NULL)t:jsr getint
  36. 420 sty flagfd:sta flagfe
  37. 422 jsr weitzei:cmp #",":beq paraut1:jmp syntax
  38. 429 paraut1 jsr chrget
  39. 430 jsr weitzei
  40. 435 cmp #",":beq paraut2
  41. 440 jsr getint
  42. 450 sty flagfb
  43. 460 sta flagfb+1:paraut2 rts
  44. 470 ;:;******** auto:;
  45. 480 auto lda zeibas+1:cmp #2:beq auto1:rts
  46. 490 auto1 jsr paraut:jsr chr(NULL)t:beq autoktex                      
  47. 491 jsr prkomma:ldy #0:auto12 lda (zeibas),y:sta dbuf,y:beq auto11
  48. 493 iny:cpy #13:bcc auto12
  49. 494 auto11 lda #0:sta dbuf,y:lda #16+2:jsr setfla:jmp auto13
  50. 496 autoktex lda #255-2:jsr clrfla:lda #16:jsr setfla
  51. 500 auto13 pla:pla:lda #>auret-1:pha:lda #<auret-1:pha
  52. 518 ldx flagfd:lda flagfe:jmp auto14
  53. 519 auv0302 clc :lda flagfb
  54. 520 adc int:sta flagfd:tax:lda flagfb+1
  55. 530 adc int+1:sta flagfe
  56. 540 auto14 sta $62:sta int+1:stx $63:stx int:ldx #$90:sec:jsr $bc49:jsr $bddf
  57. 550 jsr adrzei:bcc auto2:lda #"*":.byt $2c:auto2 lda #160
  58. 560 sei:ldy #0:sta $0277,y:iny
  59. 570 auto3 lda $ff,y:beq auto4:sta $0277,y:iny:bne auto3
  60. 580 auto4 lda #2:bit flaga:beq auto5
  61. 600 ldx #0:auto41 lda dbuf,x:beq auto5:sta $0277,y:iny:inx
  62. 610 cpy #15:bcc auto41
  63. 620 auto5 sty anzkey:cli:rts
  64. 660 ;:;******** dump:;
  65. 670 dumperr jmp syntax
  66. 680 dump bne dumperr:lda varstart:ldy varstart+1
  67. 690 du1 cpy arrstart+1:bne du2:cmp arrstart:du2 bcs duvend;groesser => ende
  68. 700 sta intadr:sty intadr+1
  69. 710 lda #13;return:jsr bsout:jsr getstop:jsr dumpvar
  70. 720 lda intadr:ldy intadr+1:clc:adc #7:bcc du1:iny:bne du1
  71. 730 dumpvar jsr duname:bcs dustrbin
  72. 740 lda intadr:adc #2:ldy intadr+1:bcc du3:iny:du3 cpx #128:bcs dufunk
  73. 750 pha:lda #" ":jsr duglout:pla:jsr $bba2;flieskommavar. holen
  74. 760 du4 jsr $bddd;in ascii-format:jmp $ab1e;ausgeben:duvend jmp duarr
  75. 770 dustrbin txa:bpl dustr;stringvar
  76. 780 lda #"%":jsr duglout:ldy #2;integervar:lda (intadr),y;low-byte:tax:iny
  77. 790 lda (intadr),y;high-byte:tay:txa:jsr $b395;in flieskomma wandeln
  78. 800 jmp du4;in ascii und ausgeben
  79. 810 dustr lda #"$":jsr duglout:jsr duhkout;hochkomma
  80. 811 lda #4:jsr setfla
  81. 820 ldy #2:lda (intadr),y;laenge:beq dustrr;fertig:sta flagff
  82. 830 iny:lda (intadr),y:sta flag22:iny:lda (intadr),y:sta flag22+1
  83. 840 ldy #0:dust1 lda (flag22),y:jsr bsout:iny:cpy flagff;fertig
  84. 850 bne dust1:dustrr lda #255-4:jsr clrfla
  85. 855 duhkout lda #$22:jmp bsout
  86. 860 dufunk ldy #2:lda (intadr),y:sec:sbc #1:sta flag5f:iny:lda (intadr),y
  87. 870 sbc #0:sta flag5f+1:iny:lda (intadr),y:sec:sbc #2:sta flag22
  88. 880 iny:lda (intadr),y:sbc #0:sta flag22+1:lda #"(":jsr bsout
  89. 890 ldy #0;argument:lda (flag22),y:jsr bsout:iny:lda (flag22),y
  90. 900 beq duf1:jsr bsout
  91. 910 duf1 lda #")":jsr duglout
  92. 920 lda #128:jsr setfla:ldy #0:sty flagff:jsr ldump
  93. 930 lda #127:jsr clrfla:rts
  94. 940 duend lda #13:jmp bsout
  95. 950 duarr lda arrstart:ldy arrstart+1
  96. 960 dua1 cpy arrend+1:bne dua2:cmp arrend:dua2 bcs duend
  97. 970 sta intadr:sty intadr+1:lda #13:jsr bsout:jsr getstop
  98. 980 jsr duname:bcc duafk;flieskomma
  99. 990 txa:bmi duaint:lda #"$":.byt $2c
  100. 1000 duaint lda #"%":.byt $2c:duafk lda #" ":jsr bsout:lda #"(":jsr bsout
  101. 1010 ldy #4:lda (intadr),y:sta flagfb;anzahl dimensionen
  102. 1020 clc:lda #5:adc intadr:sta flagfd:lda intadr+1:adc #0:sta flagfd+1
  103. 1030 jmp dua4:dua3 dec flagfb:beq duaadd:lda #",":jsr bsout
  104. 1040 dua4 lda flagfb:asl:tay:dey
  105. 1050 lda (flagfd),y:sec:sbc #1:pha:dey:lda (flagfd),y:sbc #0
  106. 1060 tay:pla:tax:tya:jsr adrout:jmp dua3
  107. 1070 duaadd lda #")":jsr bsout:ldy #2:lda (intadr),y:clc:adc intadr:pha
  108. 1080 iny:lda (intadr),y:adc intadr+1:tay:pla:jmp dua1
  109. 1090 duname ldy #0:lda (intadr),y:tax:and #127:jsr bsout
  110. 1100 iny:lda (intadr),y:tay:and #127:beq dun1:jsr bsout
  111. 1110 dun1 tya:asl:rts
  112. 1120 duglout jsr bsout;ist-gleich ausg.
  113. 1130 lda #"=":jsr bsout:rts
  114. 1140 ;:;******** find:;
  115. 1150 fiend pla:pla:jmp ready:find lda bastart+1;basic-start -1
  116. 1160 sta flagfd+1:lda bastart:sta flagfd
  117. 1170 bne d1:dec flagfd+1:d1 dec flagfd
  118. 1180 jsr d10:d2 ldy # 0:lda (flagfd),y;byte holen
  119. 1190 bne d5;nicht null:iny;zeilenende
  120. 1200 iny:lda (flagfd),y;hi-byte verkettungsadr:beq fiend;ende prg
  121. 1210 lda flagfd:sta flag5f:lda flagfd+1:sta flag5f+1
  122. 1220 lda flagfd;5 addieren als anfang text
  123. 1230 clc :adc # 5:sta flagfd
  124. 1240 bcc d4:inc flagfd+1:d4 jsr getstop;stop taste abfragen
  125. 1250 jmp d2:d5 cmp (zeibas),y;erstes zeichen gesuchter text:bne d8;nicht gefunden
  126. 1260 lda flagfd;adresszeiger retten:sta flagfb:lda flagfd+1
  127. 1270 sta flagfb+1:d6 iny :cpy flagc8;text zuende
  128. 1280 beq d9;ja,listen:lda (flagfd),y;ende zeile:beq d7;ja,weiter
  129. 1290 cmp (zeibas),y;vergleichen:beq d6:d7 lda flagfb;ungleich
  130. 1300 sta flagfd;adresszeiger zurueckholen:lda flagfb+1:sta flagfd+1
  131. 1310 d8 inc flagfd;und um 1 erhoehen:bne d2:inc flagfd+1
  132. 1320 bne d2:d9 inc flag5f:bne d09:inc flag5f+1:d09 ldy #2:lda (flag5f),y
  133. 1330 tax:iny:lda (flag5f),y:jsr llist;listen:lda # 13;carriage return
  134. 1340 jsr bsout;ausgeben
  135. 1350 d12 ldy # 255;adresszeiger auf anfang:d13 iny;naechster zeile:lda (flagfd),y
  136. 1360 bne d13:tya :clc
  137. 1370 adc flagfd:sta flagfd:bcc d14
  138. 1380 inc flagfd+1:d14 jmp d2;weitersuchen
  139. 1390 d10 ldy # 255;laenge des gesuchten:d11 iny;textes holen:lda (zeibas),y
  140. 1400 bne d11:sty flagc8:rts
  141. 1410 ;:;******** renumber:;
  142. 1412 rsyn lda #11:.byt $2c
  143. 1420 rend lda #128:.byt $2c
  144. 1430 rillq lda #14:.byt $2c
  145. 1440 rmemer lda #16
  146. 1450 sta flagc8:jsr a9:ldx flagc8:jmp $a437
  147. 1460 renum jsr paraut:lda flagfb:ora flagfb+1:bne r00:jmp illquant
  148. 1470 r00 ldy #1:lda (bastart),y:beq rend
  149. 1480 jsr a9:jsr chr(NULL)t:beq r0a:cmp #",":bne rsyn:jsr chrget:r0a jsr parlist
  150. 1482 lda intadr:ora intadr+1:bne r01:ldx #$ff:ldy #$ff:bne r02
  151. 1484 r01 ldx intadr:ldy intadr+1
  152. 1486 r02 stx flag22:sty flag22+1
  153. 1488 jmp r03:riq1 bcs rillq
  154. 1500 r1 stx flag5f:sty flag5f+1
  155. 1510 r03 ldy #1:lda (flag5f),y:beq r4
  156. 1512 ldy #3:lda (flag5f),y:cmp flag22+1:bcc rrr:bne r4
  157. 1514 dey:lda (flag5f),y:cmp flag22:bcc rrr:bne r4
  158. 1520 rrr lda strstart:sec:sbc #4:sta strstart:tax
  159. 1530 lda strstart+1:sbc #0:sta strstart+1:cmp varstart+1:bcc rmemer:bne r1a
  160. 1540 cpx varstart:bcc rmemer
  161. 1550 r1a ldy #3:lda (flag5f),y:sta (strstart),y:dey
  162. 1560 lda (flag5f),y:sta (strstart),y:dey:lda flagfd+1:sta (strstart),y
  163. 1570 tax:dey:lda flagfd:sta (strstart),y:ldy #2:sta (flag5f),y
  164. 1580 iny:txa:sta (flag5f),y:lda flagfd:clc:adc flagfb:sta flagfd
  165. 1590 lda flagfd+1:adc flagfb+1:sta flagfd+1:bcs riq1
  166. 1600 r04 ldy #0:lda (flag5f),y:tax:iny:lda (flag5f),y:tay:bne r1
  167. 1610 r4 jsr $a68e
  168. 1620 r5 ldy #0:lda (zeibas),y:bne r6
  169. 1630 iny:lda (zeibas),y:bne r7
  170. 1640 iny:lda (zeibas),y:bne r7
  171. 1650 jmp rend
  172. 1660 r7 lda zeibas:clc:adc #5:sta zeibas
  173. 1670 bcc r5:inc zeibas+1:bne r5
  174. 1680 r6 cmp #$a7:beq rthen
  175. 1690 r8 cmp #$89;goto:beq r(NULL)t
  176. 1700 cmp #$8d;gosub:beq r(NULL)t
  177. 1710 cmp #$cb;(NULL):beq r(NULL)
  178. 1715 cmp #$22;hochkomma:beq rhoko
  179. 1720 r9 inc zeibas:bne r5:inc zeibas+1:bne r5
  180. 1721 rhoko ldy #1:rho1 lda (zeibas),y:beq rho3
  181. 1722 cmp #$22:beq rho2:iny:bne rho1
  182. 1723 rho2 iny:rho3 tya:clc:adc zeibas:sta zeibas:bcc r5:inc zeibas+1:bne r5
  183. 1730 rthen jsr chrget:beq r9:bcs r8:bcc r10
  184. 1740 r(NULL) jsr chrget:cmp #$a4;to:bne r5
  185. 1750 r(NULL)t jsr chrget:bcs r5:r10 lda zeibas:sta flagfd
  186. 1760 lda zeibas+1:sta flagfd+1:jsr getint;fac in adr
  187. 1770 sec:lda zeibas:sbc flagfd:sta $57
  188. 1780 ;**** neue zeilennummer zu der alten finden
  189. 1790 lda strstart:sta flag35:lda strstart+1:sta flag35+1
  190. 1800 r11 ldy #3:lda (flag35),y:cmp intadr+1:bne r12:dey
  191. 1810 lda (flag35),y:cmp intadr:beq r13
  192. 1820 r12 lda #4:clc:adc flag35:sta flag35:tax:bcc r12a
  193. 1830 inc flag35+1:r12a lda flag35+1:cmp basend+1:bcc r11:bne r11a
  194. 1840 cpx basend:bcc r11
  195. 1850 r11a lda intadr+1:ldx intadr:jmp r14
  196. 1860 r13 dey:lda (flag35),y:pha:dey:lda (flag35),y:tax:pla
  197. 1870 r14 jsr rfacasc
  198. 1880 ldy #$ff:r15 iny:lda stack,y:bne r15
  199. 1890 lda flagfd:sta flag5f
  200. 1900 lda flagfd+1:sta flag5f+1
  201. 1910 tya:sec:sbc $57:sta $57
  202. 1920 beq r16;zahlen gleich lang:bcc r17;neue<alte => kleinere adr
  203. 1930 lda varstart:sta $5a:clc:adc $57:sta $58:sta varstart
  204. 1940 lda varstart+1:sta $5b:adc #0:sta $59:sta varstart+1
  205. 1950 cmp strstart+1:bcc r18:beq r18a:r18b jmp rmemer
  206. 1960 r18a lda varstart:cmp strstart:bcs r18b
  207. 1970 r18 jsr $a3bf:jmp r16
  208. 1980 r17 lda zeibas:sta flag5f:clc:adc $57:sta flagfb
  209. 1990 lda zeibas+1:sta flag5f+1:sbc #0:sta flagfb+1
  210. 2000 r20 ldy #0:lda (flag5f),y:sta (flagfb),y
  211. 2010 inc flagfb:bne r20a:inc flagfb+1
  212. 2020 r20a inc flag5f:bne r20b:inc flag5f+1
  213. 2030 r20b lda flag5f:cmp varstart:bne r20
  214. 2040 lda flag5f+1:cmp varstart+1:bne r20
  215. 2050 r16 lda flagfd:sta zeibas:lda flagfd+1:sta zeibas+1
  216. 2060 ldy #0:r21 lda stack,y:beq r22:sta (zeibas),y
  217. 2070 iny:bne r21
  218. 2080 r22 tya:clc:adc zeibas:sta zeibas:bcc r23
  219. 2090 inc zeibas+1:r23 jsr chr(NULL)t:cmp #",":bne r24
  220. 2100 jsr chrget:bcs r24:jmp r10:r24 jmp r5
  221. 2110 rfacasc sta $62:stx $63:ldx #$90:sec:jsr $bc49:jmp $bddf
  222.